Aminet 46/Aminet 46 (2001)(GTI - Schatztruhe)[!][Dec 2001].iso/Aminet/text/edit/edt10src.lha/txt/EClip.mod

Text File | 1995-04-08 | 6KB | 261 lines

(*
  .name       EClip
  .task       clipboard management
  .release    1.0
  .language   Oberon-2
  .translator Amiga Oberon 3.11
  .system     AmigaOS 2.04/2.1/3.0
  .author     Joachim Barheine
  .address    Hochgrevestraße 3, D-38640 Goslar
  .copyright  (c) 1994 by Joachim Barheine
*)

(* .info: 19/08/94, 01:09:17, version 21 *)

MODULE EClip;

IMPORT
  SYS:= SYSTEM,

  Dos,
  EIcon,
  Err:= ErrCodes,
  Exec,
  F:= Files,
  GUI,
  IFF:= IFFParse,
  IO:= IOServer,
  K:= Kernel,
  Sett:= Settings,
  Str:= StrPool,
  T:= Texts,
  Req:= ERequests,
  W:= Windows;

CONST
  idFTXT= SYS.VAL(LONGINT, "FTXT");
  idCHRS= SYS.VAL(LONGINT, "CHRS");

VAR
  iff: IFF.IFFHandlePtr;

PROCEDURE CloseClip;

BEGIN
  IFF.CloseIFF(iff);
  IFF.CloseClipboard(SYS.VAL(IFF.ClipboardHandlePtr, iff.stream));
END CloseClip;

PROCEDURE OpenClip(id: INTEGER; mode: LONGSET): BOOLEAN;

BEGIN
  iff.stream:= SYS.VAL(LONGINT, IFF.OpenClipboard(id));
  IF iff.stream # NIL THEN
    IFF.InitIFFasClip(iff);
    IF IFF.OpenIFF(iff, mode) = 0 THEN
      RETURN TRUE;
    ELSE
      IFF.CloseClipboard(SYS.VAL(IFF.ClipboardHandlePtr, iff.stream));
    END;
  END;
  RETURN FALSE;
END OpenClip;

PROCEDURE WriteClip(id: INTEGER; t: T.Text; pos, len: LONGINT): BOOLEAN;

VAR
  done: BOOLEAN;

  PROCEDURE WriteData(): BOOLEAN;

  CONST
    blkSize= 4096;

  VAR
    i, p, l: LONGINT;
    block: K.DynString;
    done: BOOLEAN;

  BEGIN
    done:= TRUE;
    block:= NIL;
    p:= pos;
    FOR i:= 1 TO len DIV blkSize DO
      l:= t.ReadContents(block, p, blkSize);
      done:= done & (IFF.WriteChunkBytes(iff, block^, l) = l);
      INC(p, blkSize);
    END;
    l:= t.ReadContents(block, p, len MOD blkSize);
    done:= done & (IFF.WriteChunkBytes(iff, block^, l) = l);
    DISPOSE(block);
    RETURN done;  (* done? *)
  END WriteData;

BEGIN
  done:= FALSE;
  IF OpenClip(id, IFF.write) THEN
    IF IFF.PushChunk(iff, idFTXT, IFF.idFORM, IFF.sizeUnknown) = 0 THEN
      IF IFF.PushChunk(iff, 0, idCHRS, IFF.sizeUnknown) = 0 THEN
        done:= WriteData();
        done:= (IFF.PopChunk(iff) = 0) & done;
      END;
      done:= (IFF.PopChunk(iff) = 0) & done;
    END;
    CloseClip;
  END;
  RETURN done;
END WriteClip;

PROCEDURE ReadClip(id: INTEGER; t: T.Text; pos: LONGINT): BOOLEAN;

VAR
  done: BOOLEAN;

  PROCEDURE ReadData(): BOOLEAN;

  CONST
    blkSize= 4096;

  VAR
    len, err: LONGINT;
    block: UNTRACED POINTER TO ARRAY blkSize OF CHAR;
    off: BOOLEAN;

  BEGIN
    NEW(block);
    off:= FALSE;
    t.LinkChanges;
    LOOP
      err:= IFF.ParseIFF(iff, IFF.parseScan);  (* new context *)
      IF err = 0 THEN
        REPEAT
          len:= IFF.ReadChunkBytes(iff, block^, blkSize);
          IF (len = blkSize) & ~off THEN IO.DisplayOff(t); off:= TRUE END;
          t.Insert(pos, block^, len); INC(pos, len);
        UNTIL len <= 0;
      ELSIF err # IFF.errEOC THEN  (* end of file or error *)
        EXIT;
      END;
    END;
    DISPOSE(block);
    t.LinkChangesDone;
    IF off THEN IO.DisplayOn(t) END;
    RETURN err = IFF.errEOF;
  END ReadData;

BEGIN
  done:= FALSE;
  IF OpenClip(id, IFF.read) THEN
    done:= (IFF.StopChunk(iff, idFTXT, idCHRS) = 0) & ReadData();
    CloseClip;
  END;
  RETURN done;
END ReadClip;

(* -- edit -- *)

(* clipboard: copy; 'pos' and 'len' may not be the same variable! *)
PROCEDURE ClipCopy(w: W.Window; id: INTEGER; VAR pos, len: LONGINT): BOOLEAN;

BEGIN
  IF W.markDef IN w.flags THEN
    pos:= w.markBegin;
    len:= w.markEnd - pos + 1;
    RETURN WriteClip(id, w.text(T.Text), pos, len);
  ELSE
    RETURN FALSE;
  END;
END ClipCopy;

(* clipboard: copy *)
PROCEDURE Copy* (w: W.Window; id: INTEGER);

VAR
  dummy0, dummy1: LONGINT;  (* ignore them *)

BEGIN
  IO.Busy(w.text, Str.copying^);
  IF ~ClipCopy(w, id, dummy0, dummy1) THEN
    Req.ReqMessage(w.win, Str.cannotCopyClip^, Str.cancel^);
  END;
  IO.BusyDone(w.text);
END Copy;

(* clipboard: cut *)
PROCEDURE Cut* (w: W.Window; id: INTEGER);

VAR
  pos, len: LONGINT;

BEGIN
  IF W.markDef IN w.flags THEN
    IO.Busy(w.text, Str.cutting^);
    IF ClipCopy(w, id, pos, len) THEN
      w.text(T.Text).Delete(pos, len);
    ELSE
      Req.ReqMessage(w.win, Str.cannotCopyClip^, Str.cancel^);
    END;
    IO.BusyDone(w.text);
  ELSE
    GUI.Flash;
  END;
END Cut;

PROCEDURE Paste* (w: W.Window; id: INTEGER);

BEGIN
  IO.Busy(w.text, Str.pasting^);
  IF ~ReadClip(id, w.text(T.Text), w.pos) THEN
    Req.ReqMessage(w.win, Str.cannotReadClip^, Str.cancel^);
  END;
  IO.BusyDone(w.text);
END Paste;

PROCEDURE Save* (w: W.Window; filename: ARRAY OF CHAR);

CONST
  blkSize= 4096;

VAR
  t: T.Text;
  f: F.File;
  done: BOOLEAN;
  i, p, len, l: LONGINT;
  block: K.DynString;

(* $CopyArrays- *)

BEGIN
  t:= w.text(T.Text);
  IF f.Open(filename, TRUE) THEN
    done:= TRUE;
    block:= NIL;
    p:= w.markBegin;
    len:= w.markEnd - w.markBegin + 1;
    FOR i:= 1 TO len DIV blkSize DO
      l:= t.ReadContents(block, p, blkSize);
      f.Write(block^, l);
      INC(p, blkSize);
      done:= done & f.done;
    END;
    l:= t.ReadContents(block, p, len MOD blkSize);
    f.Write(block^, l);
    done:= done & f.done;
    f.Close;
    DISPOSE(block);
    IF ~done THEN
      IF Dos.DeleteFile(filename) THEN END;
      Req.ReqMessage(w.win, Str.cannotSaveClip^, Str.cancel^);
    ELSIF Sett.icons THEN
      EIcon.PutIcon(filename, NIL);
    END;
  END;
END Save;

BEGIN
  iff:= IFF.AllocIFF();
  K.Assert(iff # NIL, Err.eClipNoClipboard);

CLOSE
  IF iff # NIL THEN IFF.FreeIFF(iff) END;
END EClip.